home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / novermdb.zip / NOVERMDB.FRM < prev    next >
Text File  |  1996-09-10  |  4KB  |  147 lines
  1. VERSION 4.00
  2. Begin VB.Form NoVerMDB 
  3.    BorderStyle     =   5  'Sizable ToolWindow
  4.    ClientHeight    =   4005
  5.    ClientLeft      =   195
  6.    ClientTop       =   1440
  7.    ClientWidth     =   8160
  8.    Height          =   4410
  9.    Left            =   135
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4005
  14.    ScaleWidth      =   8160
  15.    ShowInTaskbar   =   0   'False
  16.    Top             =   1095
  17.    Width           =   8280
  18.    Begin VB.ListBox ListFiles 
  19.       Height          =   5325
  20.       Left            =   75
  21.       TabIndex        =   0
  22.       Top             =   30
  23.       Width           =   5880
  24.    End
  25. End
  26. Attribute VB_Name = "NoVerMDB"
  27. Attribute VB_Creatable = False
  28. Attribute VB_Exposed = False
  29. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  30. Option Explicit
  31.  
  32. Function SearchMDB(ByVal DiskLetter$, l As ListBox, chMsg$, ByVal QuelleEXT As String) As Integer
  33. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  34. ReDim tRep(0) As String
  35. Dim Repertoire$, FileExt$, lo&, nDir&, nFile&
  36. On Error Resume Next
  37.  
  38. l.Clear
  39. Repertoire = Left(DiskLetter, 1) + ":\" '+ Left(CurDir, InStr(CurDir, ":")) + "\"
  40.     'NomVolume = Dir(Repertoire + "*.*", vbVolume)
  41.         
  42. Do Until Repertoire = "" Or Err > 0 Or DoEvents = 0
  43.            
  44.     FileExt = Dir(Repertoire + "*.*", vbNormal + vbHidden + vbSystem + vbDirectory + vbArchive)
  45.     Do Until FileExt = "" Or Err > 0 Or DoEvents = 0
  46.         If GetAttr(Repertoire + FileExt) And vbDirectory Then
  47.             lo& = FileLen(Repertoire + FileExt)
  48.             If Err = 53 Or Err = 76 Then
  49.                 '. .. Racine et Branche!...
  50.                 Err = 0
  51.             Else
  52.                 nDir& = nDir& + 1
  53.                 ReDim Preserve tRep(UBound(tRep) + 1)
  54.                 tRep(UBound(tRep)) = Repertoire + FileExt + "\"
  55.                 'Debug.Print tRep(UBound(tRep))
  56.             End If
  57.         ElseIf UCase(Right(Repertoire + FileExt, 4)) = "." + QuelleEXT Then
  58.             l.AddItem Repertoire + FileExt
  59.             l.TopIndex = l.ListCount - 1
  60.             nFile& = nFile& + 1
  61.         Else
  62.             nFile& = nFile& + 1
  63.         End If
  64.         FileExt = Dir
  65.     Loop
  66.     Repertoire = tRep(UBound(tRep))
  67.     If UBound(tRep) = 0 Then
  68.     Else
  69.         ReDim Preserve tRep(UBound(tRep) - 1)
  70.     End If
  71. Loop
  72.     
  73. If Err = 0 Then
  74.     chMsg = "Terminate with success for volume " + Left(CurDir, 2) + Chr(10) + _
  75.         Format(nDir) + " directories" + Chr(10) + _
  76.         Format(nFile) + " files"
  77. Else
  78.     chMsg = "Error n░" + Format(Err) + " " + Error(Err)
  79. End If
  80.  
  81. Erase tRep
  82.  
  83. SearchMDB = Err
  84. Err = 0
  85.  
  86. End Function
  87.  
  88.  
  89. Private Sub Form_Activate()
  90. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  91. Dim index As Integer, chMsg$
  92. Dim db As Database, mdb$
  93.  
  94. MousePointer = vbHourglass
  95. Screen.MousePointer = vbHourglass
  96. Enabled = False
  97.  
  98. index = SearchMDB(IIf(Len(Command) = 0, CurDir, Command), listfiles, chMsg, "MDB")
  99. Select Case index
  100. Case 0
  101.     For index = 0 To listfiles.ListCount - 1
  102.         On Error Resume Next
  103.         mdb = listfiles.List(index)
  104.         Set db = Workspaces(0).OpenDatabase(mdb)
  105.         If Err = 0 Then
  106.             listfiles.List(index) = "V. " + db.Version + Chr(9) + mdb
  107.         Else
  108.             listfiles.List(index) = "Error " + Error(Err) + Chr(9) + mdb
  109.         End If
  110.         db.Close
  111.         Kill Left(mdb, Len(mdb) - 3) + "LDB"
  112.     Next index
  113. Case Else
  114. End Select
  115.  
  116. MousePointer = vbNormal 'vbHourglass
  117. Screen.MousePointer = vbNormal 'vbHourglass
  118. Enabled = True
  119.  
  120. MsgBox "Author : " + App.CompanyName + Chr(10) + _
  121.         App.LegalCopyright + Chr(10) + Chr(10) + _
  122.         chMsg + Chr(10) + Chr(10) + _
  123.         "Command : NoVerMDB.EXE [C:]", _
  124.         vbInformation, _
  125.         App.Title
  126. End Sub
  127.  
  128. Private Sub Form_Load()
  129. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  130. On Error Resume Next
  131. Caption = "LCL - Search n░version all Jet MDBs"
  132. App.Title = Caption
  133. Top = (Screen.Height - Height) / 2
  134. Left = (Screen.Width - Width) / 2
  135. End Sub
  136.  
  137. Private Sub Form_Resize()
  138. 'FRMNoVerMDB by LCL 100413.2733@compuserve.com
  139. On Error Resume Next
  140. listfiles.Top = 0
  141. listfiles.Left = 0
  142. listfiles.Width = ScaleWidth
  143. listfiles.Height = ScaleHeight
  144. End Sub
  145.  
  146.  
  147.